home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / prefs.tcl < prev    next >
Text File  |  1997-03-28  |  7KB  |  327 lines
  1.  
  2.  
  3. #===============================================================================
  4.  
  5.  
  6. proc addArrDef {arr def val} {
  7.     addDef [list $arr $def] $val arr
  8. }
  9.  
  10. proc removeArrDef {arr def} {
  11.     removeDef [list $arr $def] arr
  12. }
  13.  
  14. proc addDef {def val {prefix {}}} {
  15.     global ${prefix}prefDefs
  16.     
  17.     readDefs $prefix
  18.     set ${prefix}prefDefs($def) $val
  19.     writeDefs $prefix
  20.     catch {unset ${prefix}prefDefs}
  21. }
  22.  
  23. proc removeDef {def {prefix {}}} {
  24.     global ${prefix}prefDefs
  25.     
  26.     readDefs $prefix
  27.     catch {unset ${prefix}prefDefs($def)}
  28.     writeDefs $prefix
  29.     catch {unset ${prefix}prefDefs}
  30. }
  31.  
  32. proc readDefs {{prefix {}}} {
  33.     global HOME PREFS globalPrefix
  34.  
  35.     if {![file exists "$PREFS:${prefix}defs.tcl"]} return
  36.     
  37.     set globalPrefix $prefix
  38.     uplevel #0 {source "$PREFS:${globalPrefix}defs.tcl"}
  39. }
  40.  
  41.  
  42. proc writeDefs {{prefix {}}} {
  43.     global HOME PREFS ${prefix}prefDefs 
  44.     
  45.     if {![info exists ${prefix}prefDefs]} {
  46.         catch {removeFile "$PREFS:${prefix}defs.tcl"}
  47.         return
  48.     }
  49.     
  50.     if {![file exists "$PREFS"]} {
  51.         mkdir "$PREFS"
  52.     }
  53.     set fd [open "$PREFS:${prefix}defs.tcl" "w"]
  54.     foreach nm [array names ${prefix}prefDefs] {
  55.         puts $fd [list set ${prefix}prefDefs($nm) [set ${prefix}prefDefs($nm)]]
  56.     }
  57.     close $fd
  58. }
  59.  
  60.  
  61. proc readUserDefs {} {
  62.     global prefDefs arrprefDefs PREFS
  63.     
  64.     if {[file exists "$PREFS:defs.tcl"]} {
  65.         source "$PREFS:defs.tcl"
  66.         
  67.         foreach nm [array names prefDefs] {
  68.             global $nm
  69.             set $nm $prefDefs($nm)
  70.         }
  71.         catch {unset prefDefs}
  72.     }
  73.     
  74.     if {[file exists "$PREFS:arrdefs.tcl"]} {
  75.         source "$PREFS:arrdefs.tcl"
  76.         
  77.         foreach nm [array names arrprefDefs] {
  78.             set arr [lindex $nm 0]
  79.             set field [lindex $nm 1]
  80.             set val $arrprefDefs($nm)
  81.             global $arr
  82.             set ${arr}($field) $val
  83.         }
  84.         catch {unset arrprefDefs}
  85.     }
  86.  
  87.     # Use "prefs.tcl" to define or change any tcl information. */
  88.     if {![file exists "$PREFS:prefs.tcl"]} {
  89.         
  90.         if {![file exists "$PREFS"]} {
  91.             mkdir "$PREFS"
  92.         }
  93.         set fd [open "$PREFS:prefs.tcl" "w"]
  94.         close $fd
  95.     }
  96.     uplevel #0 {
  97.         if {[catch {source "$PREFS:prefs.tcl"}]} {
  98.             alertnote "An error occurred while loading \"prefs.tcl\"" 
  99.         }
  100.     }
  101. }
  102.  
  103.     
  104. proc viewSavedSetting {} {
  105.     global prefDefs arrprefDefs
  106.  
  107.     saveModifiedVars
  108.     
  109.     readDefs
  110.     readDefs arr
  111.     
  112.     set res [listpick -p "The following settings have been saved:" [getSavedSettings]]
  113.  
  114.     if {[regexp {([^(]+)\(([^)]+)\)} $res dummy arr field]} {
  115.         set arg [list $arr $field]
  116.         set val $arrprefDefs($arg)
  117.     } else {
  118.         global $res
  119.         set val $prefDefs($res)
  120.     }    
  121.     viewValue $res $val
  122.     unset prefDefs arrprefDefs
  123. }
  124.  
  125. proc viewValue {name val} {
  126.     if {[string length $val] > 80} {
  127.         if {([llength $val] > 3) && ([llength $val] > 6 || [string length $val] > 160)} {
  128.             listpick -p "'$name's value is:" $val
  129.         } else {        
  130.             global tileLeft tileTop tileWidth
  131.             new -g $tileLeft $tileTop $tileWidth 100 -n "\$$name"
  132.             insertText "'$name's value is:\r\r$val\r"
  133.             setWinInfo dirty 0
  134.             setWinInfo read-only 1
  135.             goto 0
  136.         }
  137.     } else {
  138.         alertnote "'$name's value is:\r\r$val\r"
  139.     }
  140. }
  141.  
  142.  
  143. proc removeSavedSetting {} {
  144.     global prefDefs arrprefDefs
  145.     
  146.     saveModifiedVars
  147.     
  148.     readDefs
  149.     readDefs arr
  150.     set res [listpick -p "Remove which setting?" [lsort -ignore [getSavedSettings]]]
  151.  
  152.     if {$res == ""} return
  153.     if {[regexp {([^(]+)\(([^)]+)\)} $res dummy arr field]} {
  154.         global $arr
  155. #         catch {unset ${arr}($field)}
  156.         removeArrDef $arr $field
  157.     } else {
  158.         global $res
  159. #         catch {unset $res}
  160.         removeDef $res
  161.     }
  162.  
  163.     unset prefDefs arrprefDefs
  164. }
  165.  
  166.  
  167. proc getSavedSettings {} {
  168.     global prefDefs arrprefDefs
  169.     
  170.     readDefs
  171.     readDefs arr
  172.     
  173.     set names [array names prefDefs]
  174.     foreach pair [array names arrprefDefs] {
  175.         lappend names "[lindex $pair 0]([lindex $pair 1])"
  176.     }
  177.     
  178.     return [lsort $names]
  179. }
  180.  
  181. #===============================================================================
  182.  
  183. proc pushRecent {name} {
  184.     global recentFiles
  185.     
  186.     regsub { <\w+>} $name {} name
  187.     if {[string match {*\**} $name] || [string match "Untit*" $name] } return
  188.     if {[info exists recentFiles] && ([set ind [lsearch -glob $recentFiles "*[file tail $name]"]] >= 0)} {
  189.         set recentFiles [lreplace $recentFiles $ind $ind]
  190.     }
  191.     lappend recentFiles $name
  192.     if {[llength $recentFiles] > 10} {
  193.         set recentFiles [lrange $recentFiles 1 end]
  194.     }
  195.     set tails [map {file tail} $recentFiles]
  196.  
  197.     menu -m -c -n recent -p recentProc [concat [lsort -ignore $tails] [list "(-" "Reset List"]]
  198. }
  199.  
  200. proc recentProc {menu name} {
  201.     global recentFiles
  202.     
  203.     if {$name == "Reset List"} {
  204.         set recentFiles {}
  205.         menu -m -n recent -p recentProc {}
  206.     } else {
  207.         if {[set ind [lsearch $recentFiles "*:$name"]] >= 0} {
  208.             edit [lindex $recentFiles $ind]
  209.         }
  210.     }
  211. }
  212.  
  213.  
  214. proc buildRecentFiles {} {
  215.     global recentFilesSave recentFiles modifiedVars
  216.     
  217.     lappend modifiedVars
  218.     
  219.     message "Building recent files menu…"
  220.     if {[info exists recentFiles]} {
  221.         set recentFilesSave $recentFiles
  222.     }
  223.     if {[info exists recentFilesSave]} {
  224.         foreach f $recentFilesSave {
  225.             pushRecent $f
  226.         }
  227.     }
  228.         
  229.     catch {unset recentFilesSave}
  230. }
  231.  
  232.  
  233. proc appendText {t item} {return "$item$t"}
  234.  
  235.  
  236. proc editRecentFile {} {
  237.     global recentFiles
  238.     
  239.     foreach f $recentFiles {
  240.         lappend tails [file tail $f]
  241.     }
  242.     
  243.     foreach res [listpick -l -p {File?} [lsort -ignore $tails]]  {
  244.         set ind [lsearch $recentFiles \*:$res]
  245.         catch {edit [lindex $recentFiles $ind]}
  246.     }
  247. }
  248.  
  249.  
  250. #===============================================================================
  251.  
  252. proc editPrefs {} {
  253.     global PREFS
  254.     if {![file exists "$PREFS:prefs.tcl"]} {
  255.         set fd [open "$PREFS:prefs.tcl" "w"]
  256.         close $fd
  257.     }
  258.     edit "$PREFS:prefs.tcl"
  259. }
  260.  
  261. # Automatically add a line to the user input file
  262. proc addUserLine {line} {
  263.     global HOME PREFS
  264.  
  265.     if {![file exists "$PREFS"]} {
  266.         mkdir "$PREFS"
  267.     }
  268.     set fid [open "$PREFS:prefs.tcl" "a+"]
  269.     if {![catch {seek $fid -1 end}]} {
  270.         if {[read $fid 1] == "\r"} {
  271.             set line "\r$line"
  272.         }
  273.     }
  274.     seek $fid 0 end
  275.     puts $fid $line
  276.     close $fid
  277. }
  278.  
  279.  
  280.  
  281. #===============================================================================
  282.  
  283. proc sourceCurrentModePrefs {} { 
  284.     global mode PREFS
  285.     if {[file exists "${PREFS}:${mode}Prefs.tcl"]} {
  286.         source  "${PREFS}:${mode}Prefs.tcl"
  287.     } else {
  288.         beep; message "Sorry, no preferences for '$mode' mode"
  289.     }
  290. }
  291.  
  292.  
  293. proc editCurrentModePrefs {} { 
  294.     global mode
  295.     editPrefsProc modePrefs $mode
  296. }
  297.  
  298.  
  299. proc editPrefsProc { menu m } {
  300.     message $m
  301.     global PREFS mode
  302.     # assume it is a mode, since we made the menu
  303.     
  304.     set f "$PREFS:${m}Prefs.tcl"
  305.     if [file exists $f] {
  306.         edit $f
  307.     } else {
  308.         if { [askyesno "No '$m' prefs file exists, do you want to create one?"] \
  309.             == "yes" } {
  310.             
  311.             set fd [open $f "w"]
  312.             close $fd
  313.             edit $f
  314.             insertText {## 
  315.  # This    file will be sourced automatically, immediately after 
  316.  # the _first_ time    the    file which defines its mode is sourced.
  317.  # Use this    file to    insert your    own    mode-specific preferences
  318.  # and changes,    rather than    altering the originals.
  319.  # 
  320.  # You can redefine    menus, procedures, variables,...
  321.  ##
  322.  
  323. }}}
  324.             
  325. }
  326.  
  327.